Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/Animation Routines/B - CellusoftAnimations.p

Text File | 1993-03-31 | 9.9 KB | 244 lines | [TEXT/PJMM]

{All procedures in this unit were created by Tony Small, author of Cellusoft games.  You may feel free to pass this code}
{along to whom ever you like and look through the code and learn from it at your leisure.}

{If, however, you choose to use any of the code below in one of your programs, you are first obligated to pay the standard}
{shareware fee of $15.  Upon payment of the fee, you may use any of the following procedures or the unit as a whole as many}
{times as you choose in as many projects that you choose.   It would also be appreciated if you mention Tony Small in}
{in the credits of any program you use his procedures in.}

{Those who pay the shareware fee of $15 will also be informed of future Cellusoft games and future Cellusoft programming}
{routines.  Registered users will also be able to beta test all future Cellusoft games and be named in the credits when}
{appropriate.}

{In order to register, please send $15 to:     Tony Small}
                                                  {18606 Cassandra St.}
                                                  {Tarzana, CA 91356}

{unit CellusoftAnimations© 1993 Tony Small - All Rights Reserved WorldWide}

{***Note*** - to use these routines, you don't necessarily have to understand them.  Simply read through the }
{explanations in the interface section below and examine how they are used in the program sample file.}

{Questions?  Send mail or E-mail  AOL - TonyS33}

unit CellusoftAnimations;

interface

    uses
        BasicRoutines;        {The BasicRoutines unit must be placed before this unit in order to use all the available routines.}

    const
        MaxAnimations = 15;    {This number specifies the maximum number of sprites you plan to use in your program.}
                                {The higher the number, the more memory your program will require.}

    type
        AnimationRecord = record        {This record is used by the animationr routines.}
                active: boolean;
                lRect, cRect, pRect: rect;
                theGraf, theMaskGraf: GrafPtr;
            end;

    var
        animArray: array[1..MaxAnimations] of AnimationRecord;
        tr: array[1..4] of rect;    {An array of four temporary rects (tr) used periodically throughout the unit.}
        Pic_Handle: PicHandle;
        theregion: RgnHandle;

{The following two procedures will alow you, in one line of code, to create a port of any size, and place a picture}
{from a PICT resource onto the port.  If you want the port to be blank, specify Picture as -1.}
{ThePort - The name of the port variable, of type GrafPtr.}
{Picture - The ID of the PICT resource to place on the port.  Specify as -1 if you want the port to be blank.}
{right, bottom - integers specifying the size of the port.}
    procedure DoColorPort (var ThePort: GrafPtr; Picture, right, bottom: integer);
    procedure DoPort (var ThePort: GrafPtr; Picture, right, bottom: integer);

{Call these procedures to release the memory used up by color and black and white ports.}
    procedure Trash (var ThePort: GrafPtr);
    procedure TrashColor (var ThePort: GrafPtr);

{This procedure will take the GrafPtr Origin, and create a port of identical size called Destination and effectively perform}
{a horizontal swap of the picture on Origin.  This procedure is good to use if you want to save disk space by not having}
{to put horizontally swapped pictures into the resource.  Set the variable Color to true if the GrafPtr is a color port.}
    procedure HorizontalFlip (var Origin, Destination: GrafPtr; Color: boolean);

{The following two procedures are simply easier ways to call sometimes complicated system routines.}
{Copy replaces CopyBits.  With this, you do not need to put in ^.portbits and specify the regionhandle and other odd variables.}
{This simply copies from Port1 to Port2, from Rect1 to Rect2.}
{MoveRect moves TheRect, the specified integers.  MoveRect is used by other CellusoftAnimations routines.}
    procedure Copy (var Port1, Port2: GrafPtr; var Rect1, Rect2: rect);
    procedure MoveRect (var TheRect: rect; left, up, right, down: integer);     {Mainly used in the Animation procedure, this is a quick way to move a rect.}

{The following procedures help to manage the actual animation process.  Call InitAnimations after every animation loop.}
{InitAnimations will reset the animArray to its original state.}
{Call SetAnimation to add an animation to the array. tlRect specifies where the animated graphic was last on the screne.}
{tcRect specifies where the animated graphic is now on the screne.  tpRect specifies the location of the graphic on the GrafPtr}
{where the actual picture to be animated is located.  ttheGraf is the port that holds that picture and tthemaskGraf is the port}
{with the mask of that picture.}
{AnimateArray will animate all of the animations you specified with each SetAnimation call.  The maximum number of animations there}
{can be at the same time is only limited by the constant MaxAnimations.  This procedure also handled the collisions of any}
{number of animations without flicker.}
{pureback is the port that holds the original picture of the background graphic.  offLoad is a blank port the same size of the}
{MainWindow.  MainWindow is the pointer to the window where the user will see the animations take place.}
{***Note*** - The method of animation I used was developed by John Calhoun, author of Glider 4.0.  If you would like to learn}
{move about the flicker free technique used by his programs and by these routines, then look for either Glypha 2.0 source code}
{or Glypha Primer offered by John Calhoun available on AOL and other bulletin boards.}
    procedure InitAnimations;
    procedure AnimateArray (pureback, offLoad: GrafPtr; MainWindow: WindowPtr);
    procedure SetAnimation (tlRect, tcRect, tpRect: rect; ttheGraf, tthemaskGraf: GrafPtr);

implementation

    procedure AnimateArray (pureback, offLoad: GrafPtr; MainWindow: WindowPtr);
        var
            i, j: integer;
            wRect: array[1..MaxAnimations] of rect;
            col: array[1..MaxAnimations] of boolean;
    begin
        for i := 1 to MaxAnimations do
            with animArray[i] do
                if active then
                    unionRect(lRect, cRect, wRect[i]);
        for i := 1 to MaxAnimations do
            with animArray[i] do
                if active then
                    begin
                        for j := i + 1 to MaxAnimations do
                            col[j] := false;
                        tr[2] := wRect[i];
                        for j := i + 1 to MaxAnimations do
                            with animArray[j] do
                                if active then
                                    if sectRect(tr[2], wRect[j], tr[1]) then
                                        begin
                                            col[j] := true;
                                            animArray[j].active := false;
                                            unionRect(tr[2], wRect[j], tr[2]);
                                        end;
                        col[i] := true;
                        begin
                            copy(pureback, offLoad, tr[2], tr[2]);
                            for j := i to MaxAnimations do
                                if col[j] then
                                    with AnimArray[j] do
                                        begin
                                            copymask(theGraf^.portbits, theMaskGraf^.portbits, offLoad^.portbits, pRect, pRect, cRect);
                                        end;
                            copy(offLoad, MainWindow, tr[2], tr[2]);
                        end;
                    end;
    end;

    procedure SetAnimation (tlRect, tcRect, tpRect: rect; ttheGraf, tthemaskGraf: GrafPtr);
        var
            i: integer;
    begin
        i := 1;
        while animArray[i].active and (i < MaxAnimations) do
            i := i + 1;
        with animArray[i] do
            begin
                active := true;
                lRect := tlRect;
                cRect := tcRect;
                pRect := tpRect;
                theGraf := ttheGraf;
                theMaskGraf := ttheMaskGraf;
            end;
    end;

    procedure InitAnimations;
        var
            i: integer;
    begin
        for i := 1 to MaxAnimations do
            animArray[i].active := false;
    end;

    procedure Copy (var Port1, Port2: GrafPtr; var Rect1, Rect2: rect);

    begin
        copyBits(Port1^.portbits, Port2^.portbits, Rect1, Rect2, 0, theregion);
    end;

    procedure MoveRect (var TheRect: rect; left, up, right, down: integer);     {Mainly used in the Animation procedure, this is a quick way to move a rect.}
    begin
        TheRect.left := TheRect.left + left;
        TheRect.top := TheRect.top + up;
        TheRect.right := TheRect.right + right;
        TheRect.bottom := TheRect.bottom + down;
    end;

    procedure HorizontalFlip (var Origin, Destination: GrafPtr; Color: boolean);
        var
            i: integer;
    begin
        tr[1] := Origin^.portrect;
        if Color then
            DoColorPort(Destination, -1, tr[1].right, tr[1].bottom)
        else
            DoPort(Destination, -1, tr[1].right, tr[1].bottom);
        setRect(tr[2], 0, 0, 1, tr[1].bottom);
        setRect(tr[3], tr[1].right - 1, 0, tr[1].right, tr[1].bottom);
        for i := 1 to tr[1].right do
            begin
                copy(Origin, Destination, tr[2], tr[3]);
                moveRect(tr[2], 1, 0, 1, 0);
                moveRect(tr[3], -1, 0, -1, 0);
            end;
    end;

    procedure Trash (var ThePort: GrafPtr);
    begin
        DisposeOffScreenPort(ThePort);
    end;

    procedure TrashColor (var ThePort: GrafPtr);
    begin
        DisposeOffScreenColorPort(CGrafPtr(ThePort));
    end;

    procedure DoColorPort (var ThePort: GrafPtr; Picture, right, bottom: integer);

    {This procedure creates a PixMap within ThePort, with PICT resource Picture, and with rect size right and bottom.}

    begin
        SetRect(tR[1], 0, 0, right, bottom);        {Set the rect temprect to the size designated by the caller.}

        ThePort := GrafPtr(NewOffScreenColorPort(tR[1]));    {Creates the PixMap.}
        if thePort <> nil then                                    {If there wasnt a memory problem, then...}
            begin
                SetPort(ThePort);                        {Set the port to the port its creating.}

                EraseRect(tR[1]);                                {Set the port to white, to rid of the garbage.}
                if Picture <> -1 then
                    begin
                        Pic_Handle := GetPicture(Picture);                {Get the picture from the resource.}
                        DrawPicture(Pic_Handle, tR[1]);                {Draw it onto the port.}
                    end;
            end;
    end;

    procedure DoPort (var ThePort: GrafPtr; Picture, right, bottom: integer);

    {This procedure creates a PixMap within ThePort, with PICT resource Picture, and with rect size right and bottom.}

    begin
        SetRect(tR[1], 0, 0, right, bottom);        {Set the rect temprect to the size designated by the caller.}

        ThePort := NewOffScreenPort(tR[1]);    {Creates the PixMap.}
        if thePort <> nil then                                    {If there wasnt a memory problem, then...}
            begin
                SetPort(ThePort);                        {Set the port to the port its creating.}
                EraseRect(tR[1]);                                {Set the port to white, to rid of the garbage.}
                if Picture <> -1 then
                    begin
                        Pic_Handle := GetPicture(Picture);                {Get the picture from the resource.}
                        DrawPicture(Pic_Handle, tR[1]);                {Draw it onto the port.}
                    end;
            end;
    end;



end.